#!/usr/bin/perl

package Swignition::Export::Calendar;
use Swignition::Export;
use Swignition::Export::CalComponent;
use HTML::Entities qw(encode_entities_numeric);

sub is
{
	my $subject = shift;
	return unless ($subject);
	return unless (ref $subject eq 'Swignition::RDFModel::Subject');	
	
	return 1 if (Swignition::Export::Feed::is($subject));
	
	return
		unless (defined $subject->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'));
	foreach my $Type ( @{$subject
		->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type')
		->valObjects} )
	{
		my $type = $Type->toString;
		return 1 if ($type eq 'urn:ietf:rfc:2445#Vcalendar'
						|| $type eq 'http://buzzword.org.uk/rdf/icalx#Vcalendar');
	}
	
	return;
}

sub outputs
{
	return [
		{
			code  => 'ICS',
			name  => 'iCalendar',
			type  => 'text/directory',
			multi => 1
		}
	];
}

sub outICS
{
	my $triples = shift;
	my $subject = shift;
	my $S = findSubject($triples, $subject);

	# Note that the W3C RDF iCal vocab (which Swignition does support) doesn't
	# actually support the concept of a "calendar" as such: just events, todos,
	# journal entries, etc. If you want to export standalone components like
	# that, then use Swignition::Export::CalComponent::multiICS. This function
	# only supports actual calendar objects (feeds are a special case of that).
	# A calendar object can be created in RDF my giving it an rdf:type of
	# "urn:ietf:rfc:2445#vcalendar" and linking to component resources using
	# either "urn:ietf:rfc:2445#vevent" and its bretheren, or dcterms:hasPart.
	
	my @components = allOf($S,
		'urn:ietf:rfc:2445#vevent',
		'http://buzzword.org.uk/rdf/icalx#vevent',
		'urn:ietf:rfc:2445#vtodo',
		'http://buzzword.org.uk/rdf/icalx#vtodo',
		'urn:ietf:rfc:2445#valarm',
		'http://buzzword.org.uk/rdf/icalx#valarm',
		'urn:ietf:rfc:2445#vjournal',
		'http://buzzword.org.uk/rdf/icalx#vjournal',
		'urn:ietf:rfc:2445#vfreebusy',
		'http://buzzword.org.uk/rdf/icalx#vfreebusy',
		'http://purl.org/dc/terms/hasPart',
		'http://purl.org/rss/1.0/items',
		'urn:ietf:rfc:4287#entry',
		'http://purl.invalid/stuff/atom/owl#entry',
		'http://bblfish.net/work/atom-owl/2006-06-06/#entry'		
	);
	
	my %qualified_components;
	foreach my $c (@components)
	{
		my $C = findSubject($triples, $c);
		next unless($C);
		
		if (Swignition::Export::CalComponent::is($C))
		{
			unless (defined $qualified_components{$c})
				{ $qualified_components{$c} = 1; }
			
			# Any alarm which is embedded within another component is disqualified.
			my @alarms = allOf($C, 'urn:ietf:rfc:2445#valarm');
			foreach my $a (@alarms)
			{
				$qualified_components{$a} = 0;
			}
		}
	}
	
	@components = ();
	foreach my $c (keys %qualified_components)
	{
		if ($qualified_components{$c})
		{
			push @components, $c;
		}
	}
	
	my $rv = "BEGIN:VCALENDAR\r\n";
	
	my $ver = firstOfLiteral($S,
		['urn:ietf:rfc:2445#version',
		'http://www.w3.org/2002/12/cal/ical#version'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	if ($ver)
		{ $rv .= "VERSION:$ver\r\n"; }
	else
		{ $rv .= "VERSION:2.0\r\n"; }
		
	my $prodid = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#prodid',
		'http://www.w3.org/2002/12/cal/ical#prodid'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	if ($prodid)
		{ $rv .= "PRODID:$prodid\r\n"; }
	else
		{ $rv .= "PRODID:+//IDN buzzword.org.uk//NONSGML Swignition 0.1//EN\r\n"; }

	my $method = uc(firstOfLiteral($S,
		['urn:ietf:rfc:2445#method',
		'http://www.w3.org/2002/12/cal/ical#method'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']));
	if ($method)
		{ $rv .= "METHOD:$method\r\n"; }
	else
		{ $rv .= "METHOD:PUBLISH\r\n"; }

	my $title = firstOfLiteral($S,
		['urn:ietf:rfc:2445#x-wr-calname',
		'http://buzzword.org.uk/rdf/icalx#xWrCalname',
		'urn:ietf:rfc:4287#title',
		'http://purl.org/rss/1.0/title',
		'http://purl.org/dc/terms/title',
		'http://purl.org/dc/elements/1.1/title'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	$rv .= "X-WR-CALNAME:$title\r\n" if ($title);

	my $desc = firstOfLiteral($S,
		['urn:ietf:rfc:2445#x-wr-caldesc',
		'http://buzzword.org.uk/rdf/icalx#xWrCaldesc',
		'http://purl.org/rss/1.0/description',
		'http://purl.org/dc/terms/description',
		'http://purl.org/dc/elements/1.1/description',
		'http://purl.org/dc/terms/abstract',
		'urn:ietf:rfc:4287#subtitle'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	$rv .= "X-WR-CALDESC:$desc\r\n" if ($desc);	
	
	my $scale = uc(firstOfLiteral($S, 
		['urn:ietf:rfc:2445#calscale',
		'http://www.w3.org/2002/12/cal/ical#calscale'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']));
	if ($scale)
		{ $rv .= "CALSCALE:$calscale\r\n"; }
	else
		{ $rv .= "CALSCALE:GREGORIAN\r\n"; }

	foreach my $c (@components)
	{
		$rv .= Swignition::Export::CalComponent::_outICS($triples, $c);
	}

	$rv .= "END:VCALENDAR\r\n";
	
	return $rv;
}

sub multiICS
{
	my $triples = shift;
	my $rv = '';
	foreach my $s (keys %$triples)
	{
		$rv .= outICS($triples, $s)
			if (defined $triples->{$s} && is($triples->{$s}));
	}
	return $rv;
}

1;
